home *** CD-ROM | disk | FTP | other *** search
- /*
- ** Demosource on how to use customclasses in D.
- ** Based on the C example 'Class2.c' by Stafan Stuntz.
- ** Translated TO E by Sven Steiniger
- ** Translated to D by Martin <MarK> Kuchinka
- */
-
- OPT OPTIMIZE
-
- MODULE 'muimaster','libraries/mui',
- 'intuition/classes','intuition/classusr','intuition/screens','intuition/intuition',
- 'utility','utility/tagitem',
- 'lib/amiga'
-
- /***************************************************************************/
- /* Here is the beginning of our simple new class... */
- /***************************************************************************/
-
- /*
- ** This class is the same as within Class1.c except that it features
- ** a pen attribute.
- */
-
- OBJECT mydata
- penspec:MUI_PenSpec,
- pen:LONG,
- penchange
-
- CONST MYATTR_PEN=$8022 /* tag value for the new attribute. */
-
-
- PROC mNew(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO OpSet)(L)
- DEF data:PTR TO mydata,
- tags:PTR TO TagItem,
- tag:PTR TO TagItem
-
- IFN obj:=DoSuperMethodA(cl,obj,msg) THEN RETURN NIL
-
- data:=INST_DATA(cl,obj)
-
- /* parse initial taglist */
- tags:=msg.AttrList
- WHILE tag:=NextTagItem(&tags)
- IF tag.Tag=MYATTR_PEN THEN
- IF tag.Data THEN CopyMem(tag.Data,data.penspec,SIZEOF_MUI_PenSpec)
- ENDWHILE
-
- ENDPROC obj
-
-
- /* OM_NEW didnt allocates something, just DO nothing here... */
-
- PROC mDispose(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO Msg)(L) IS
- DoSuperMethodA(cl,obj,msg)
-
-
- PROC mSet(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO OpSet)(L)
- DEF data:PTR TO mydata,
- tags:PTR TO TagItem,
- tag:PTR TO TagItem
-
- data:=INST_DATA(cl,obj)
- tags:=msg.AttrList
- WHILE tag:=NextTagItem(&tags)
- IF tag.Tag=MYATTR_PEN THEN
- IF tag.Data
- CopyMem(tag.Data,data.penspec,SIZEOF_MUI_PenSpec)
- data.penchange:=TRUE
- MUI_Redraw(obj,MADF_DRAWOBJECT) /* redraw ourselves completely */
- ENDIF
- ENDWHILE
-
- ENDPROC DoSuperMethodA(cl,obj,msg)
-
-
- /*
- ** OM_GET method, see if someone wants to read the color.
- */
-
- PROC mGet(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO OpGet)(L)
- DEF data:PTR TO mydata,storage:PTR TO LONG
-
- IF msg.AttrID=MYATTR_PEN
- data:=INST_DATA(cl,obj)
- storage:=msg.Storage
- storage[]:=data.penspec
- RETURN MUI_TRUE
- ENDIF
-
- ENDPROC DoSuperMethodA(cl,obj,msg)
-
-
- PROC mSetup(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO Msg)(L)
- DEF data:PTR TO mydata
-
- IFN DoSuperMethodA(cl,obj,msg) THEN RETURN FALSE
- data:=INST_DATA(cl,obj)
- data.pen:=MUI_ObtainPen(muiRenderInfo(obj),data.penspec,0)
-
- ENDPROC MUI_TRUE
-
-
- PROC mCleanup(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO Msg)(L)
- DEF data:PTR TO mydata
-
- data:=INST_DATA(cl,obj)
- MUI_ReleasePen(muiRenderInfo(obj),data.pen)
-
- ENDPROC DoSuperMethodA(cl,obj,msg)
-
-
- /*
- ** AskMinMax method will be called before the window is opened
- ** and before layout takes place. We need to tell MUI the
- ** minimum, maximum and default size of our object.
- */
-
- PROC mAskMinMax(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO MUIP_AskMinMax)(L)
-
- /*
- ** let our superclass first fill in what it thinks about sizes.
- ** this will e.g. add the size OF frame and inner spacing.
- */
-
- DoSuperMethodA(cl,obj,msg)
-
- /*
- ** now add the values specific TO our object. note that we
- ** indeed need TO *add* these values, not just set them!
- */
-
- msg.MinMaxInfo.MinWidth += 100
- msg.MinMaxInfo.DefWidth += 120
- msg.MinMaxInfo.MaxWidth += 500
-
- msg.MinMaxInfo.MinHeight += 40
- msg.MinMaxInfo.DefHeight += 90
- msg.MinMaxInfo.MaxHeight += 300
-
- ENDPROC 0
-
-
- /*
- ** Draw method is called whenever MUI feels we should render
- ** our object. This usually happens after layout is finished
- ** or when we need to refresh in a simplerefresh window.
- ** Note: You may only render within the rectangle
- ** _mleft(obj), _mtop(obj), _mwidth(obj), _mheight(obj).
- */
-
- PROC mDraw(cl:PTR TO IClass,obj:PTR TO _Object,msg:PTR TO MUIP_Draw)(L)
- DEF data:PTR TO mydata,
- i
-
- data:=INST_DATA(cl,obj)
-
- /*
- ** let our superclass draw itself first, area class would
- ** e.g. draw the frame and clear the whole region. What
- ** it does exactly depends on msg.flags.
- */
-
- DoSuperMethodA(cl,obj,msg)
-
- /*
- ** IF MADF_DRAWOBJECT isn't set, we shouldn't draw anything.
- ** MUI just wanted TO update the frame OR something like that.
- */
-
- IFN msg.flags & MADF_DRAWOBJECT THEN RETURN 0
-
- /*
- ** test IF someone changed our pen
- */
-
- IF data.penchange
- data.penchange:=FALSE
- MUI_ReleasePen(muiRenderInfo(obj),data.pen)
- data.pen:=MUI_ObtainPen(muiRenderInfo(obj),data.penspec,0)
- ENDIF
-
-
- /*
- ** ok, everything ready TO render...
- ** Note that we *must* use the MUIPEN() macro before actually
- ** using pens from MUI_ObtainPen() in rendering calls.
- */
-
- SetAPen(_rp(obj),MUIPEN(data.pen))
-
- FOR i:=_mleft(obj) TO _mright(obj) STEP 5
- Move(_rp(obj),_mleft(obj),_mbottom(obj))
- Draw(_rp(obj),i,_mtop(obj))
- Move(_rp(obj),_mright(obj),_mbottom(obj))
- Draw(_rp(obj),i,_mtop(obj))
- ENDFOR
-
- ENDPROC 0
-
-
- /*
- ** Here comes the dispatcher FOR our custom class.
- ** Unknown/unused methods are passed to the superclass immediately.
- */
-
- PROC MyDispatcher(cl:PTR TO IClass IN a0,obj IN a2,msg:PTR TO Msg IN a1)(LONG)
-
- SELECT msg.MethodID
- CASE OM_NEW ; RETURN mNew (cl,obj,msg)
- CASE OM_DISPOSE ; RETURN mDispose (cl,obj,msg)
- CASE OM_SET ; RETURN mSet (cl,obj,msg)
- CASE OM_GET ; RETURN mGet (cl,obj,msg)
- CASE MUIM_AskMinMax ; RETURN mAskMinMax(cl,obj,msg)
- CASE MUIM_Setup ; RETURN mSetup (cl,obj,msg)
- CASE MUIM_Cleanup ; RETURN mCleanup (cl,obj,msg)
- CASE MUIM_Draw ; RETURN mDraw (cl,obj,msg)
- ENDSELECT
-
- ENDPROC DoSuperMethodA(cl,obj,msg)
-
-
-
- /***************************************************************************/
- /* Thats all there is about it. Now lets see how things are used... */
- /***************************************************************************/
-
- DEF MUIMasterBase,UtilityBase
-
- PROC main()
- DEF app=NIL,window,myobj,pen,
- mcc=NIL:PTR TO MUI_CustomClass,
- startpen:PTR TO MUI_PenSpec,
- sigs=0
-
- IFN MUIMasterBase:=OpenLibrary(MUIMASTER_NAME, MUIMASTER_VMIN) THEN
- Raise('Failed to open muimaster.library')
-
- /*
- ** open utility.library, because we need function NextTagItem()
- */
- IFN UtilityBase:=OpenLibrary('utility.library',36) THEN
- Raise('Failed to open utility.library')
-
-
- /* Create the NEW custom class with a call TO MUI_CreateCustomClass(). */
- /* Caution: This function returns not a struct IClass, BUT a */
- /* struct MUI_CustomClass which contains a struct IClass TO be */
- /* used with NewObject() calls. */
- /* Note well: MUI creates the dispatcher hook FOR you, you may */
- /* *not* use its h_Data field! IF you need custom data, use the */
- /* cl_UserData OF the IClass structure! */
-
- IFN mcc:=MUI_CreateCustomClass(NIL,MUIC_Area,NIL,SIZEOF_mydata,&MyDispatcher) THEN
- Raise('Could not create custom class.')
-
- app:=ApplicationObject,
- MUIA_Application_Title, 'Class2',
- MUIA_Application_Version, '$VER: Class2 12.9 (21.11.95)',
- MUIA_Application_Copyright, '©1995, Stefan Stuntz',
- MUIA_Application_Author, 'Stefan Stuntz',
- MUIA_Application_Description,'Demonstrate the use of custom classes.',
- MUIA_Application_Base, 'CLASS2',
-
- SubWindow, window:=WindowObject,
- MUIA_Window_Title,'Another Custom Class',
- MUIA_Window_ID,"CLS2",
- WindowContents,VGroup,
- Child, TextObject,
- TextFrame,
- MUIA_Background,MUII_TextBack,
- -> E-note : center this text means inserting a <ESC c> which is usually \ec
- MUIA_Text_Contents,
- '\ecThis is a custom class with attributes.\n'+
- 'Click on the button at the bottom of\n'+
- 'the window to adjust the color.',
- End,
- Child,myobj:=NewObjectA(mcc.Class,NIL,[TextFrame,
- MUIA_Background, MUII_BACKGROUND,
- TAG_DONE]),
- Child,HGroup,MUIA_Weight,10,
- Child,FreeLabel('Custom Class Color:'),
- Child,pen:=PoppenObject,
- MUIA_CycleChain,1,
- MUIA_Window_Title,'Custom Class Color',
- End,
- End,
- End,
- End,
- End
-
- IFN app THEN Raise('Failed to create Application.')
-
- DoMethodA(window,[MUIM_Notify,MUIA_Window_CloseRequest,MUI_TRUE,
- app,2,MUIM_Application_ReturnID,MUIV_Application_ReturnID_Quit])
-
- DoMethodA(pen,[MUIM_Notify,MUIA_Pendisplay_Spec,MUIV_EveryTime,
- myobj,3,MUIM_Set,MYATTR_PEN,MUIV_TriggerValue])
-
- get(pen,MUIA_Pendisplay_Spec,&startpen)
- set(myobj,MYATTR_PEN,startpen)
-
- /*
- ** This is the ideal input loop for an object oriented MUI application.
- ** Everything is encapsulated in classes, no return ids need to be used,
- ** we just check if the program shall terminate.
- ** Note that MUIM_Application_NewInput expects sigs to contain the result
- ** from Wait() (or 0). This makes the input loop significantly faster.
- */
-
- set(window,MUIA_Window_Open,MUI_TRUE)
-
- WHILE Not(DoMethodA(app,[MUIM_Application_NewInput,&sigs]) = MUIV_Application_ReturnID_Quit)
- IF sigs THEN sigs := Wait(sigs)
- ENDWHILE
-
- set(window,MUIA_Window_Open,FALSE)
-
- /*
- ** Shut down...
- */
-
- EXCEPTDO
- IF app THEN MUI_DisposeObject(app) /* dispose all objects. */
- IF mcc THEN MUI_DeleteCustomClass(mcc) /* delete the custom class. */
- IF UtilityBase THEN CloseLibrary(UtilityBase)
- IF MUIMasterBase THEN CloseLibrary(MUIMasterBase) /* close library */
- IF exception THEN PrintF('\s\n',exception)
- ENDPROC
-